home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / designer.arc / DESIGNER.BAS (.txt) next >
Encoding:
GW-BASIC  |  1985-05-28  |  18.3 KB  |  599 lines
  1. 10000  REM **************************************************************
  2. 10010  REM **                  THE DESIGNER V1.0                       **
  3. 10020  REM **           Copyright 1983, by Jan B. Young                **
  4. 10030  REM **************************************************************
  5. 10040  KEY OFF:ON ERROR GOTO 14930:CAPS=1:PURGE=0
  6. 10050  OPEN "A:DESIGNER.DRV" FOR INPUT AS #1
  7. 10060  INPUT #1,DRIVE$
  8. 10070  CLOSE #1
  9. 10080  KEY(1) ON:ON KEY(1) GOSUB 10440
  10. 10090  KEY(2) ON:ON KEY(2) GOSUB 10450
  11. 10100  KEY(3) ON:ON KEY(3) GOSUB 10460
  12. 10110  KEY(4) ON:ON KEY(4) GOSUB 10470
  13. 10120  KEY(5) ON:ON KEY(5) GOSUB 10480
  14. 10130  KEY(6) ON:ON KEY(6) GOSUB 10490
  15. 10140  KEY(7) ON:ON KEY(7) GOSUB 10500
  16. 10150  KEY(8) ON:ON KEY(8) GOSUB 10510
  17. 10160  KEY(9) ON:ON KEY(9) GOSUB 10520
  18. 10170  KEY(10) ON:ON KEY(10) GOSUB 10530
  19. 10180  REM **************************************************************
  20. 10190  REM **                    Mainline                              **
  21. 10200  REM **************************************************************
  22. 10210  SKIP$ = "INS":NOW$="INS"
  23. 10220  REC=1:GOSUB 15490
  24. 10230  IF SKIP$="INS" THEN GOSUB 10540
  25. 10240  IF SKIP$="NEW" THEN GOSUB 11000
  26. 10250  IF SKIP$="TXT" THEN GOSUB 12170
  27. 10260  IF SKIP$="SCL" THEN GOSUB 12680
  28. 10270  IF SKIP$="SSP" THEN GOSUB 13470
  29. 10280  IF SKIP$="RSP" THEN GOSUB 14330
  30. 10290  IF SKIP$="ANI" THEN GOSUB 13870
  31. 10300  IF SKIP$="RSC" THEN GOSUB 14610
  32. 10310  IF SKIP$="SSC" THEN GOSUB 14740
  33. 10320  IF SKIP$ <> "" GOTO 10230
  34. 10330  SCREEN 0,0,0:WIDTH 80:END
  35. 10340  REC=5:GOSUB 15490
  36. 10350  GOSUB 15220:IF TYPE$<>"C" THEN GOTO 10350
  37. 10360  IF X$ < "A" OR X$ > "D" THEN GOTO 10350
  38. 10370  OPEN "A:DESIGNER.DRV" FOR OUTPUT AS #1
  39. 10380  WRITE #1, X$:CLOSE #1:DRIVE$=X$:GOTO 10080
  40. 10390  REC=19:GOSUB 15490:GOSUB 15220:SCREEN 0,0,0:END ' no color/graph card
  41. 10400  REC=24:GOSUB 15490:GOSUB 15220:SCREEN 0,0,0:END  ' no printer
  42. 10410  REM *************************************************************
  43. 10420  REM **                   Key Settings                          **
  44. 10430  REM *************************************************************
  45. 10440  SKIP$ = "NEW":RETURN
  46. 10450  SKIP$ = "SCL":RETURN
  47. 10460  SKIP$ = "SSP":RETURN
  48. 10470  SKIP$ = "SSC":RETURN
  49. 10480  SKIP$ = "RSP":RETURN
  50. 10490  SKIP$ = "RSC":RETURN
  51. 10500  SKIP$ = "TXT":RETURN
  52. 10510  SKIP$ = "ANI":RETURN
  53. 10520  SKIP$ = "INS":RETURN
  54. 10530  SKIP$ = "":RETURN
  55. 10540  REM *************************************************************
  56. 10550  REM **  F9     INS = Instructions / Command List               **
  57. 10560  REM *************************************************************
  58. 10570  NOW$="INS"
  59. 10580  REC=28:GOSUB 15490
  60. 10590  LOCATE 21,10:PRINT DRIVE$+"."
  61. 10600  GOSUB 15220:IF SKIP$<>"INS" THEN RETURN
  62. 10610  IF ASC(X$) = 8 THEN GOTO 10600
  63. 10620  IF TYPE$ <> "C" THEN GOTO 10600
  64. 10630  LOCATE 8,62:PRINT USING "\         \";"          "+X$:Y$=X$
  65. 10640  GOSUB 15220:IF SKIP$<>"INS" THEN RETURN
  66. 10650  IF TYPE$ <> "C" THEN GOTO 10640
  67. 10660  IF ASC(X$) <> 8 THEN GOTO 10690
  68. 10670  LOCATE 8,62:PRINT USING "\          \";"            "
  69. 10680  GOTO 10600
  70. 10690  LOCATE 8,73:PRINT X$:Y$=Y$+X$
  71. 10700  GOSUB 15220:IF SKIP$<>"INS" THEN RETURN
  72. 10710  IF TYPE$ <> "C" THEN GOTO 10700
  73. 10720  IF ASC(X$) <> 8 THEN GOTO 10750
  74. 10730  LOCATE 8,73:PRINT " "
  75. 10740  GOTO 10640
  76. 10750  LOCATE 8,74:PRINT X$:X$=Y$+X$
  77. 10760  REC=0
  78. 10770  IF X$="INS" THEN GOTO 10580
  79. 10780  IF X$="GEN" THEN REC = 46
  80. 10790  IF X$="NEW" THEN REC = 140
  81. 10800  IF X$="SCL" THEN REC = 189
  82. 10810  IF X$="RSP" THEN REC = 271
  83. 10820  IF X$="SSP" THEN REC = 301
  84. 10830  IF X$="RSC" THEN REC = 328
  85. 10840  IF X$="SSC" THEN REC = 352
  86. 10850  IF X$="ANI" THEN REC = 363
  87. 10860  IF X$="TXT" THEN REC = 389
  88. 10870  IF X$="CRD" THEN REC = 435
  89. 10880  IF X$="DRV" THEN GOTO 10920
  90. 10890  IF REC <> 0 THEN GOTO 10910
  91. 10900  LOCATE 8,62:PRINT "Try Again:   ":GOTO 10600
  92. 10910  GOSUB 15490:RETURN
  93. 10920  OPEN "A:DESIGNER.DRV" FOR OUTPUT AS #1
  94. 10930  IF DRIVE$="A" THEN GOTO 10980
  95. 10940  IF DRIVE$="D" THEN DRIVE$="A"
  96. 10950  IF DRIVE$="C" THEN DRIVE$="D"
  97. 10960  IF DRIVE$="B" THEN DRIVE$="C"
  98. 10970  GOTO 10990
  99. 10980  DRIVE$="B"
  100. 10990  WRITE #1,DRIVE$:CLOSE #1:RETURN
  101. 11000  REM *************************************************************
  102. 11010  REM **   F1      NEW = New Figure or Screen                    **
  103. 11020  REM *************************************************************
  104. 11030  NOW$="NEW":REC=471:GOSUB 15490
  105. 11040  GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN
  106. 11050  IF TYPE$<>"C" THEN 11040
  107. 11060  IF X$="H" THEN GOTO 11090
  108. 11070  IF X$="M" THEN GOTO 11100
  109. 11080  GOTO 11040
  110. 11090  RES1=2:BAK=0:GOTO 11230
  111. 11100  REC = 474:RES1=1
  112. 11110  GOSUB 15490
  113. 11120  GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN
  114. 11130  IF X$="1" THEN GOTO 11160
  115. 11140  IF X$="0" THEN GOTO 11170
  116. 11150  GOTO 11120
  117. 11160  REC=478:PAL=1:GOTO 11180
  118. 11170  REC=489:PAL=0
  119. 11180  GOSUB 15490
  120. 11190  GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN
  121. 11200  IF TYPE$<>"C" THEN 11190
  122. 11210  BAK=ASC(X$)-65
  123. 11220  IF BAK<0 OR BAK >15 THEN GOTO 11190
  124. 11230  RES=RES1:CLS:CLR=1:GRID=0:SCREEN RES:LAST=0
  125. 11240  IF RES=1 THEN COLOR BAK,PAL
  126. 11250  REM ********* intermediate entry point ***********
  127. 11260  HLOC=160*RES:VLOC=100
  128. 11270  PSET(HLOC,VLOC)
  129. 11280  IF LAST=1 THEN PRESET(HLOC,VLOC+1),CLR
  130. 11290  IF LAST=2 THEN PRESET(HLOC-1,VLOC),CLR
  131. 11300  IF LAST=3 THEN PRESET(HLOC,VLOC-1),CLR
  132. 11310  IF LAST=4 THEN PRESET(HLOC+1,VLOC),CLR
  133. 11320  PURGE=1:GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN
  134. 11330  IF TYPE$="G" THEN GOTO 11530
  135. 11340  IF X$ = "G" THEN GOTO 11380
  136. 11350  IF X$>="A" AND X$ <="Z" THEN HOLD$=X$
  137. 11360  IF X$=>"0" AND X$ <="9" THEN GOTO 11580
  138. 11370  GOTO 11320
  139. 11380  IF GRID=1 THEN GOTO 11460
  140. 11390  FOR I = 9 TO 200 STEP 10
  141. 11400  LINE (0,I)-(4*RES,I),1:LINE (315*RES,I)-(320*RES,I),1
  142. 11410  NEXT I
  143. 11420  FOR I = 9 TO 320*RES STEP 10
  144. 11430  LINE (I,0)-(I,4),1:LINE (I,195)-(I,200),1
  145. 11440  NEXT I
  146. 11450  GRID=1:GOTO 11320
  147. 11460  FOR I = 9 TO 200 STEP 10
  148. 11470  LINE (0,I)-(4*RES,I),0:LINE (315*RES,I)-(320*RES,I),0
  149. 11480  NEXT I
  150. 11490  FOR I = 9 TO 320*RES STEP 10
  151. 11500  LINE (I,0)-(I,4),0:LINE (I,195)-(I,200),0
  152. 11510  NEXT I
  153. 11520  GRID=0:GOTO 11320
  154. 11530  IF X$="H" THEN GOTO 12140
  155. 11540  IF X$="M" THEN GOTO 12120
  156. 11550  IF X$="P" THEN GOTO 12100
  157. 11560  IF X$="K" THEN GOTO 12080
  158. 11570  GOTO 11320
  159. 11580  IF HOLD$ <>"P" THEN GOTO 11630
  160. 11590  IF X$<"0" OR  X$>"3" OR (RES=2 AND X$>"1") THEN GOTO 11630
  161. 11600  PRESET (HLOC,VLOC)
  162. 11610  PAINT (HLOC,VLOC),(ASC(X$)-48),CLR
  163. 11620  PRESET (HLOC,VLOC),CLR
  164. 11630  IF HOLD$="F" AND X$="0" THEN CLR=0
  165. 11640  IF HOLD$="F" AND X$="1" THEN CLR=1
  166. 11650  IF HOLD$="F" AND X$="2" THEN CLR=2
  167. 11660  IF HOLD$="F" AND X$="3" THEN CLR=3
  168. 11670  IF HOLD$="F" THEN HOLD$=""
  169. 11680  IF HOLD$<>"D" OR X$ <> "1" THEN GOTO 11710
  170. 11690  VSET=VLOC:HSET=HLOC:HOLD$=""
  171. 11700  GOTO 11320
  172. 11710  IF HOLD$<>"D" OR X$ <> "2" THEN GOTO 11740
  173. 11720  LINE (HSET,VSET)-(HLOC,VLOC),CLR:HOLD$=""
  174. 11730  GOTO 11320
  175. 11740  IF HOLD$<>"C" OR X$<> "1" THEN GOTO 11770
  176. 11750  VSET=VLOC:HSET=HLOC:HOLD$=""
  177. 11760  GOTO 11320
  178. 11770  IF HOLD$<>"C" OR X$<> "2" THEN GOTO 11830
  179. 11780  IF RES=2 THEN RAD=SQR(5.7*(VSET-VLOC)^2+(HSET-HLOC)^2)
  180. 11790  IF RES=1 THEN RAD=SQR(1.45*(VSET-VLOC)^2+(HSET-HLOC)^2)
  181. 11800  CIRCLE (HSET,VSET),RAD,CLR
  182. 11810  HOLD$=""
  183. 11820  GOTO 11320
  184. 11830  IF HOLD$<>"A" OR X$<> "1" THEN GOTO 11860
  185. 11840  VSET=VLOC:HSET=HLOC:HOLD$=""
  186. 11850  GOTO 11320
  187. 11860  IF HOLD$<>"A" OR X$<>"2" THEN GOTO 11890
  188. 11870  VSET2=VLOC:HSET2=HLOC:HOLD$=""
  189. 11880  GOTO 11320
  190. 11890  IF HOLD$<>"A" OR X$<>"3" THEN GOTO 11320
  191. 11900  IF RES=2 THEN GOTO 11990
  192. 11910  RAD=SQR(1.4*(VSET-VSET2)^2+(HSET-HSET2)^2)
  193. 11920  ANG1=ATN(1.25*(VSET-VSET2)/(HSET2-HSET))
  194. 11930  ANG2=ATN(1.25*(VSET-VLOC)/(HLOC-HSET))
  195. 11940  IF HSET>HLOC THEN ANG2=3.14+ANG2
  196. 11950  IF HLOC>HSET AND VLOC>VSET THEN ANG2=6.28+ANG2
  197. 11960  IF HSET>HSET2 THEN ANG1=3.14+ANG1
  198. 11970  IF HSET2>HSET AND VSET2>VSET THEN ANG1=6.28+ANG1
  199. 11980  GOTO 12060
  200. 11990  RAD=SQR(5.7*(VSET-VSET2)^2+(HSET-HSET2)^2)
  201. 12000  ANG1=ATN(2.5*(VSET-VSET2)/(HSET2-HSET))
  202. 12010  ANG2=ATN(2.5*(VSET-VLOC)/(HLOC-HSET))
  203. 12020  IF HSET>HLOC THEN ANG2=3.14+ANG2
  204. 12030  IF HLOC>HSET AND VLOC>VSET THEN ANG2=6.28+ANG2
  205. 12040  IF HSET>HSET2 THEN ANG1=3.14+ANG1
  206. 12050  IF HSET2>HSET AND VSET2>VSET THEN ANG1=6.28+ANG1
  207. 12060  CIRCLE (HSET,VSET),RAD,CLR,ANG1,ANG2
  208. 12070  HOLD$="":GOTO 11320
  209. 12080  IF HLOC > 0 THEN HLOC=HLOC-1
  210. 12090  LAST=4:GOTO 11270
  211. 12100  IF VLOC < 199 THEN VLOC=VLOC+1
  212. 12110  LAST=3:GOTO 11270
  213. 12120  IF HLOC < RES*320-1 THEN HLOC=HLOC+1
  214. 12130  LAST=2:GOTO 11270
  215. 12140  IF VLOC > 0 THEN VLOC=VLOC-1
  216. 12150  LAST=1:GOTO 11270
  217. 12160  RETURN
  218. 12170  REM *************************************************************
  219. 12180  REM **  F7      TXT = Add Text Characters                      **
  220. 12190  REM *************************************************************
  221. 12200  IF RES <> 0 THEN GOTO 12220
  222. 12210  NOW$="TXT":REC=500:GOSUB 15490:GOSUB 15220:RETURN
  223. 12220  NOW$="TXT":CAPS=0:START=1:MSG=0:GOSUB 15920
  224. 12230  PRESET (HLOC,VLOC),CLR
  225. 12240  OPEN "A:TEXTCHAR" AS #1 LEN=12:GOTO 12250
  226. 12250  FIELD #1,12 AS BUFFER$
  227. 12260  DIM HOLDC(2),HOLDB(2*(3-RES))
  228. 12270  PURGE=1:GOSUB 15220:IF SKIP$="NEW" THEN GOTO 12650
  229. 12280  IF SKIP$ <> "TXT" THEN GOTO 12640
  230. 12290  IF TYPE$="C" AND ASC(X$) > 31 AND ASC(X$) < 126 THEN GOTO 12500
  231. 12300  IF TYPE$ = "C" THEN GOTO 12270
  232. 12310  IF X$ <>"H" AND X$ <>"M" AND X$<>"P" AND X$<>"K" THEN GOTO 12270
  233. 12320  IF START=1 THEN GOTO 12270
  234. 12330  PUT (HLOC,VLOC),HOLDB,PSET
  235. 12340  IF X$="H" THEN GOTO 12390
  236. 12350  IF X$="M" THEN GOTO 12410
  237. 12360  IF X$="P" THEN GOTO 12430
  238. 12370  IF X$="K" THEN GOTO 12450
  239. 12380  GOTO 12270
  240. 12390  IF VLOC > 0 THEN VLOC=VLOC-1
  241. 12400  GOTO 12470
  242. 12410  IF HLOC < RES*320-7 THEN HLOC=HLOC+1
  243. 12420  GOTO 12470
  244. 12430  IF VLOC < 192 THEN VLOC=VLOC+1
  245. 12440  GOTO 12470
  246. 12450  IF HLOC > 0 THEN HLOC=HLOC-1
  247. 12460  GOTO 12470
  248. 12470  GET(HLOC,VLOC)-(HLOC+6,VLOC+7),HOLDB
  249. 12480  PUT (HLOC,VLOC),HOLDC,PSET
  250. 12490  GOTO 12270
  251. 12500  IF ASC(X$) > 32 THEN GOTO 12550
  252. 12510  FOR I=HLOC TO HLOC+3*RES:FOR J=VLOC TO VLOC+7
  253. 12520  PSET (I,J),0
  254. 12530  NEXT J,I
  255. 12540  GOTO 12270
  256. 12550  GET #1,ASC(X$)-32+(2-RES)*93
  257. 12560  OUTPUT$=BUFFER$
  258. 12570  FOR J= 0 TO 2
  259. 12580  HOLDC(J)=CVS(MID$(OUTPUT$,4*J+1,4))
  260. 12590  NEXT J
  261. 12600  HLOC=RES*160-3:VLOC=97:START=0
  262. 12610  GET(HLOC,VLOC)-(HLOC+6,VLOC+7),HOLDB
  263. 12620  PUT (HLOC,VLOC),HOLDC,PSET
  264. 12630  GOTO 12270
  265. 12640  ERASE HOLDC,HOLDB:CLOSE #1:CAPS=1:RETURN
  266. 12650  ERASE HOLDC,HOLDB:CLOSE #1:CAPS=1:SKIP$="NEW":NOW$="NEW"
  267. 12660  MSG=0:GOSUB 15920:GOTO 11260
  268. 12670  REC=503:GOSUB 15490:GOSUB 15220:RETURN
  269. 12680  REM *************************************************************
  270. 12690  REM **  F2        SCL = Scale a Drawing     Color 0,14         **
  271. 12700  REM *************************************************************
  272. 12710  IF RES <> 0 THEN GOTO 12730
  273. 12720  NOW$="SCL":REC=510:GOSUB 15490:GOSUB 15220:RETURN
  274. 12730  NOW$="SCL":MSG=0:GOSUB 15920
  275. 12740  SPEED=0:PRESET (HLOC,VLOC),CLR
  276. 12750  GOSUB 15220:IF SKIP$="NEW" THEN GOTO 13460
  277. 12760  IF SKIP$ <> "SCL" THEN RETURN
  278. 12770  IF TYPE$="G" THEN GOTO 12750
  279. 12780  IF X$ > "0" AND X$ <= "9" AND HOLD$ <> " " THEN SPEED = 1-(ASC(X$)-48)/25
  280. 12790  IF X$ = "E" THEN HOLD$ = "E"
  281. 12800  IF X$ = "C" THEN HOLD$ = "C"
  282. 12810  IF SPEED = 0 OR HOLD$ = " " THEN GOTO 12750
  283. 12820  IF HOLD$ = "E" THEN GOTO 13140
  284. 12830  REM ***** contract - left side *****
  285. 12840  FOR I = 160*RES TO 0 STEP -1
  286. 12850  IF SKIP$<>"SCL" THEN RETURN
  287. 12860  PSET(I,0),1:PSET(I,199),1
  288. 12870  K=160*RES-(160*RES-I)/SPEED
  289. 12880  FOR J = 100 TO 1 STEP -1
  290. 12890  L=100-(100-J)/SPEED
  291. 12900  IF K >=0 AND L >=0 THEN PSET (I,J),POINT(K,L) ELSE PSET (I,J),0
  292. 12910  NEXT J
  293. 12920  FOR J = 101 TO 198
  294. 12930  L=100+(J-100)/SPEED
  295. 12940  IF K >=0 AND L <=199 THEN PSET (I,J),POINT(K,L) ELSE PSET (I,J),0
  296. 12950  NEXT J
  297. 12960  PSET(I,0),0:PSET(I,199),0
  298. 12970  NEXT I
  299. 12980  REM *****  contract - right side *****
  300. 12990  FOR I = 160*RES + 1 TO 320*RES-1
  301. 13000  IF SKIP$<>"SCL" THEN RETURN
  302. 13010  PSET(I,0),1:PSET(I,199),1
  303. 13020  K=160*RES+(I-160*RES)/SPEED
  304. 13030  FOR J = 100 TO 1 STEP -1
  305. 13040  L=100-(100-J)/SPEED
  306. 13050  IF K <= 320*RES-1 AND L >= 0 THEN PSET(I,J),POINT(K,L) ELSE PSET(I,J),0
  307. 13060  NEXT J
  308. 13070  FOR J = 101 TO 198
  309. 13080  L=100+(J-100)/SPEED
  310. 13090  IF K <= 320*RES-1 AND L <=199 THEN PSET (I,J),POINT(K,L) ELSE PSET (I,J),0
  311. 13100  NEXT J
  312. 13110  PSET(I,0),0:PSET(I,199),0
  313. 13120  NEXT I
  314. 13130  SPEED = 0:HOLD$ = " ":MSG=0:GOSUB 15920:GOTO 12750
  315. 13140  REM ***** expand - left side *****
  316. 13150  SPEED = 2-SPEED
  317. 13160  FOR I = 0 TO 160*RES
  318. 13170  IF SKIP$<>"SCL" THEN RETURN
  319. 13180  PSET(I,0),1:PSET(I,199),1
  320. 13190  K=160*RES-((160*RES-I)/SPEED)
  321. 13200  FOR J = 1 TO 100
  322. 13210  L=100-((100-J)/SPEED)
  323. 13220  PSET (I,J),POINT(K,L)
  324. 13230  NEXT J
  325. 13240  FOR J = 198 TO 101 STEP -1
  326. 13250  L=100-((100-J)/SPEED)
  327. 13260  PSET (I,J),POINT(K,L)
  328. 13270  NEXT J
  329. 13280  PSET(I,0),0:PSET(I,199),0
  330. 13290  NEXT I
  331. 13300  REM *****  expand - right side *****
  332. 13310  FOR I = 320*RES-1 TO 160*RES + 1 STEP -1
  333. 13320  IF SKIP$<>"SCL" THEN RETURN
  334. 13330  PSET(I,0),1:PSET(I,199),1
  335. 13340  K = (I-160*RES)/SPEED + 160*RES
  336. 13350  FOR J = 1 TO 100
  337. 13360  L=100-(100-J)/SPEED
  338. 13370  PSET(I,J),POINT(K,L)
  339. 13380  NEXT J
  340. 13390  FOR J = 198 TO 101 STEP -1
  341. 13400  L=(J-100)/SPEED + 100
  342. 13410  PSET (I,J),POINT(K,L)
  343. 13420  NEXT J
  344. 13430  PSET(I,0),0:PSET(I,199),0
  345. 13440  NEXT I
  346. 13450  SPEED = 0:HOLD$ = " ":MSG=0:GOSUB 15920:GOTO 12750
  347. 13460  SKIP$="NEW":NOW$="NEW":MSG=0:GOSUB 15920:GOTO 11260
  348. 13470  REM *************************************************************
  349. 13480  REM **  F3       SSP = Store a Sprite                          **
  350. 13490  REM *************************************************************
  351. 13500  IF RES <> 0 THEN GOTO 13520
  352. 13510  NOW$="SSP":REC=513:GOSUB 15490:GOSUB 15220:RETURN
  353. 13520  RES1=RES:NOW$="SSP"
  354. 13530  L=1:R=320*RES1:T=1:B=200:SPEED=1
  355. 13540  LINE (L,T)-(R,B),1,B
  356. 13550  PURGE=1:GOSUB 15220:IF SKIP$<>"SSP" THEN RETURN
  357. 13560  IF TYPE$="G" THEN GOTO 13780
  358. 13570  IF X$<"1" OR X$>"9" THEN GOTO 13600
  359. 13580  SPEED = ASC(X$)-48
  360. 13590  GOTO 13550
  361. 13600  IF X$<>"G" THEN GOTO 13550
  362. 13610  R=R-1:L=L+1:T=T+1:B=B-1
  363. 13620  I=4+INT(((R-L+1)*(3-RES1)+7)/8)*(B-T+1)
  364. 13630  I=INT((3+I)/4)+1:J=FRE(" ")
  365. 13640  IF J>((I*4)+500) THEN GOTO 13660
  366. 13650  MSG=1001:GOSUB 15920:GOTO 13550
  367. 13660  DIM HOLD(I)
  368. 13670  GET (L,T)-(R,B),HOLD
  369. 13680  REC=516:VLOC=6:GOSUB 15340:IF SKIP$<>"SSP" THEN GOTO 13760
  370. 13690  OPEN Y$+".SPR" FOR OUTPUT AS #1
  371. 13700  WRITE #1,RES1,PAL,I,R-L+1,B-T+1
  372. 13710  FOR J= 0 TO I
  373. 13720  K=VARPTR(HOLD(J))
  374. 13730  WRITE #1,PEEK(K),PEEK(K+1),PEEK(K+2),PEEK(K+3)
  375. 13740  NEXT J
  376. 13750  REC = 520:GOSUB 15490:GOSUB 15220:SKIP$="INS"
  377. 13760  CLOSE #1:ERASE HOLD
  378. 13770  RETURN
  379. 13780  LINE (L,T)-(R,B),0,B
  380. 13790  IF X$="H" THEN B=B-SPEED
  381. 13800  IF X$="M" THEN L=L+SPEED
  382. 13810  IF X$="P" THEN T=T+SPEED
  383. 13820  IF X$="K" THEN R=R-SPEED
  384. 13830  IF B<T+2 THEN B=T+2
  385. 13840  IF L>R-2 THEN L=R-2
  386. 13850  GOTO 13540
  387. 13860  RETURN
  388. 13870  REM *************************************************************
  389. 13880  REM **  F8          ANI = Test Animation                       **
  390. 13890  REM *************************************************************
  391. 13900  NOW$="ANI":REC=521:VLOC=4:GOSUB 15340:IF SKIP$<>"ANI" THEN RETURN
  392. 13910  REC=524:Z$=Y$:VLOC=6:GOSUB 15340:IF SKIP$<>"ANI" THEN RETURN
  393. 13920  OPEN Z$+".RES" FOR INPUT AS #1:GOTO 13930
  394. 13930  INPUT #1,RES1,BAK,PAL1
  395. 13940  CLOSE #1
  396. 13950  OPEN Y$+".SPR" FOR INPUT AS #1:GOTO 13960
  397. 13960  INPUT #1,RES,PAL,I,WID,HGHT
  398. 13970  DIM HOLDC(I),HOLDB(I):GOTO 13980
  399. 13980  FOR J=0 TO I
  400. 13990  K=VARPTR(HOLDC(J)):INPUT #1,H(0),H(1),H(2),H(3)
  401. 14000  FOR L=0 TO 3:POKE K+L,H(L):NEXT L
  402. 14010  NEXT J
  403. 14020  CLOSE #1
  404. 14030  HLOC=(320*RES-WID)/2:VLOC=(200-HGHT)/2
  405. 14040  SCREEN RES
  406. 14050  IF RES = 1 THEN COLOR BAK,PAL
  407. 14060  DEF SEG=&HB800
  408. 14070  BLOAD Z$,0
  409. 14080  DEF SEG
  410. 14090  GET (HLOC,VLOC)-(HLOC+WID-1,VLOC+HGHT-1),HOLDB
  411. 14100  Y$="P":PUT (HLOC,VLOC),HOLDC,PSET
  412. 14110  PURGE=1:GOSUB 15220: IF SKIP$ <> "ANI" THEN GOTO 14290
  413. 14120  IF TYPE$ <> "G" THEN GOTO 14240
  414. 14130  PUT (HLOC,VLOC),HOLDB,PSET
  415. 14140  IF X$ = "H" AND VLOC > 0 THEN VLOC=VLOC-1
  416. 14150  IF X$ = "M" AND HLOC < RES*319-WID+1 THEN HLOC=HLOC+1
  417. 14160  IF X$ = "P" AND VLOC < 200-HGHT THEN VLOC=VLOC+1
  418. 14170  IF X$ = "K" AND HLOC > 0 THEN HLOC=HLOC-1
  419. 14180  GET (HLOC,VLOC)-(HLOC+WID-1,VLOC+HGHT-1),HOLDB
  420. 14190  IF Y$="P" THEN PUT (HLOC,VLOC),HOLDC,PSET
  421. 14200  IF Y$="A" THEN PUT (HLOC,VLOC),HOLDC,AND
  422. 14210  IF Y$="O" THEN PUT (HLOC,VLOC),HOLDC,OR
  423. 14220  IF Y$="X" THEN PUT (HLOC,VLOC),HOLDC,XOR
  424. 14230  GOTO 14110
  425. 14240  IF X$="X" THEN Y$="X"
  426. 14250  IF X$="A" THEN Y$="A"
  427. 14260  IF X$="O" THEN Y$="O"
  428. 14270  IF X$="P" THEN Y$="P"
  429. 14280  GOTO 14110
  430. 14290  CLOSE #1:ERASE HOLDB:ERASE HOLDC:RETURN
  431. 14300  REC=525:GOSUB 15490:GOSUB 15220:RETURN
  432. 14310  REC=528:GOSUB 15490:GOSUB 15220:RETURN
  433. 14320  REC=531:GOSUB 15490:GOSUB 15220:RETURN
  434. 14330  REM *************************************************************
  435. 14340  REM **  F5        RSP = Retrieve a Sprite                      **
  436. 14350  REM *************************************************************
  437. 14360  NOW$="RSP":REC=534:VLOC=4:GOSUB 15340:IF SKIP$<>"RSP" THEN RETURN
  438. 14370  OPEN Y$+".SPR" FOR INPUT AS #1
  439. 14380  INPUT #1,RES1,PAL,I,WID,HGHT
  440. 14390  DIM HOLDC(I)
  441. 14400  IF RES1 <>1 THEN GOTO 14460
  442. 14410  REC=537:GOSUB 15490
  443. 14420  GOSUB 15220:IF SKIP$<>"RSP" THEN GOTO 14580
  444. 14430  IF TYPE$<>"C" THEN 14420
  445. 14440  BAK=ASC(X$)-65
  446. 14450  IF BAK<0 OR BAK >15 THEN GOTO 14420
  447. 14460  SCREEN RES1:RES=RES1
  448. 14470  CLS
  449. 14480  IF RES=1 THEN COLOR BAK,PAL
  450. 14490  FOR J= 0 TO I
  451. 14500  K=VARPTR(HOLDC(J)):INPUT #1,H(0),H(1),H(2),H(3)
  452. 14510  FOR L=0 TO 3:POKE K+L,H(L):NEXT L
  453. 14520  NEXT J
  454. 14530  HLOC=(320*RES-WID)/2:VLOC=(200-HGHT)/2
  455. 14540  PUT (HLOC,VLOC),HOLDC:ERASE HOLDC
  456. 14550  CLOSE #1
  457. 14560  SKIP$="NEW":NOW$="NEW"
  458. 14570  GOTO 11260
  459. 14580  CLOSE #1:ERASE HOLD:RETURN
  460. 14590  REC=572:GOSUB 15490:GOSUB 15220:RETURN
  461. 14600  REC=548:GOSUB 15490:GOSUB 15220:RETURN
  462. 14610  REM *************************************************************
  463. 14620  REM **  F6       RSC = Retrieve a Screen                       **
  464. 14630  REM *************************************************************
  465. 14640  NOW$="RSC":REC=551:VLOC=4:GOSUB 15340:IF SKIP$<>"RSC" THEN RETURN
  466. 14650  OPEN Y$+".RES" FOR INPUT AS #1:INPUT #1,RES,BAK,PAL:CLOSE #1
  467. 14660  SCREEN RES
  468. 14670  IF RES=1 THEN COLOR BAK,PAL
  469. 14680  DEF SEG=&HB800
  470. 14690  BLOAD Y$,0
  471. 14700  DEF SEG
  472. 14710  SKIP$="NEW":NOW$="NEW"
  473. 14720  GOTO 11260
  474. 14730  REC=554:GOSUB 15490:GOSUB 15220:RETURN
  475. 14740  REM *************************************************************
  476. 14750  REM **  F4          SSC = Store a Screen       Color 0,3       **
  477. 14760  REM *************************************************************
  478. 14770  IF RES <> 0 THEN GOTO 14790
  479. 14780  NOW$="SSC":REC=557:GOSUB 15490:GOSUB 15220:RETURN
  480. 14790  RES1=RES:NOW$="SSC":PRESET (HLOC,VLOC),CLR
  481. 14800  DEF SEG= &HB800
  482. 14810  BSAVE DRIVE$+":SCREEN",0,&H4000:DEF SEG
  483. 14820  REC=560:VLOC=19:GOSUB 15340:IF SKIP$<>"SSC" THEN RETURN
  484. 14830  IF LEN(Y$) > 2 THEN NAME DRIVE$+":SCREEN.BAS" AS Y$+".BAS":GOTO 14840
  485. 14840  IF LEN(Y$) = 2 THEN Y$ = DRIVE$+":SCREEN"
  486. 14850  OPEN Y$+".RES" FOR OUTPUT AS #1
  487. 14860  WRITE #1,RES1,BAK,PAL
  488. 14870  CLOSE #1:CLS:REC=569
  489. 14880  NOW$="INS":SKIP$="INS":GOSUB 15490
  490. 14890  RETURN
  491. 14900  REC=571:GOSUB 15490:LOCATE 19,37:PRINT "        ":GOTO 14820
  492. 14910  REC=576:GOSUB 15490:LOCATE 19,37:PRINT "        ":RETURN
  493. 14920  REC=581:GOSUB 15490:LOCATE 19,37:PRINT "        ":RETURN
  494. 14930  REM *************************************************************
  495. 14940  REM **              Error Handling                             **
  496. 14950  REM *************************************************************
  497. 14960  MSG=ERR:GOSUB 15920
  498. 14970  IF ERR = 7 AND ERL = 13970 THEN RESUME 14320
  499. 14980  IF ERR = 7 AND ERL = 14390 THEN RESUME 14600
  500. 14990  IF (ERR = 24 OR ERR = 25) AND ERL = 15790 THEN RESUME 15850
  501. 15000  IF ERR = 61 AND ERL = 14810 THEN RESUME 14910
  502. 15010  IF ERR = 61 AND ERL = 14870 THEN RESUME 14920
  503. 15020  IF ERR = 68 AND ERL = 15790 THEN RESUME 10400
  504. 15030  IF (ERR = 53 OR ERR = 52) AND ERL = 10050 THEN RESUME 10340
  505. 15040  IF (ERR = 53 OR ERR = 52) AND ERL = 12240 THEN RESUME 12670
  506. 15050  IF (ERR = 53 OR ERR = 52) AND ERL = 13920 THEN RESUME 14300
  507. 15060  IF (ERR = 53 OR ERR = 52) AND ERL = 13950 THEN RESUME 14310
  508. 15070  IF (ERR = 53 OR ERR = 52) AND ERL = 14370 THEN RESUME 14590
  509. 15080  IF (ERR = 53 OR ERR = 52) AND ERL = 14650 THEN RESUME 14730
  510. 15090  IF ERR = 58 AND ERL = 14830 THEN RESUME 14900
  511. 15100  IF ERR = 71 AND ERL = 15530 THEN RESUME 15860
  512. 15110  IF ERR = 72 AND ERL = 15530 THEN RESUME 15910
  513. 15120  CLS
  514. 15130  PRINT "Error number ",ERR," at line number ",ERL
  515. 15140  PRINT
  516. 15150  PRINT "Please notify: Jan Young"
  517. 15160  PRINT "               767 N. Holden St."
  518. 15170  PRINT "               Port Washington, Wi.  53074"
  519. 15180  PRINT
  520. 15190  PRINT "Please include the error number and line number above and"
  521. 15200  PRINT "as much information about what you were doing as possible."
  522. 15210  END
  523. 15220  REM *************************************************************
  524. 15230  REM **               Read From Keyboard                        **
  525. 15240  REM *************************************************************
  526. 15250  IF PURGE=0 THEN 15270
  527. 15260  DEF SEG=&H40:POKE &H1A,PEEK(&H1C):DEF SEG
  528. 15270  X$=INKEY$:IF SKIP$<>NOW$ THEN PURGE=0:RETURN
  529. 15280  IF X$="" THEN 15270
  530. 15290  IF LEN(X$)<>2 THEN 15320
  531. 15300  X$=MID$(X$,2,1)
  532. 15310  TYPE$="G":PURGE=0:RETURN
  533. 15320  IF ASC(X$)>96 AND CAPS=1 THEN X$=CHR$(ASC(X$)-32)
  534. 15330  TYPE$="C":PURGE=0:RETURN
  535. 15340  REM *************************************************************
  536. 15350  REM **              Read 8 Characters From Keyboard            **
  537. 15360  REM *************************************************************
  538. 15370  Y$=DRIVE$+":":GOSUB 15490
  539. 15380  FOR J=1 TO 8
  540. 15390  GOSUB 15220:IF SKIP$<>NOW$ THEN RETURN
  541. 15400  IF TYPE$<>"C" THEN 15390
  542. 15410  IF ASC(X$) <> 8 THEN GOTO 15440
  543. 15420  IF J=1 THEN GOTO 15390
  544. 15430  J=J-1:X$=" ":LOCATE VLOC,62+J:PRINT X$:Y$=MID$(Y$,1,J+1):GOTO 15390
  545. 15440  IF ASC(X$) = 13 THEN GOTO 15480
  546. 15450  IF ASC(X$) = 46 THEN GOTO 15390
  547. 15460  LOCATE VLOC,62+J:PRINT X$:Y$=Y$+X$
  548. 15470  NEXT J
  549. 15480  RETURN
  550. 15490  REM *************************************************************
  551. 15500  REM **         Print Verbiage Screens                          **
  552. 15510  REM *************************************************************
  553. 15520  WIDTH 80:SCREEN 0,1:RES=0
  554. 15530  OPEN "A:VERBIAGE" AS #2 LEN=85
  555. 15540  FIELD #2,85 AS BUFFER$
  556. 15550  GET 2,REC:OUTREC$ = BUFFER$
  557. 15560  IF SKIP$<>NOW$ THEN GOTO 15770
  558. 15570  IF MID$(OUTREC$,1,3)<>"c01" THEN GOTO 15600
  559. 15580  COLOR (VAL(MID$(OUTREC$,4,2))),(VAL(MID$(OUTREC$,6,2))),(VAL(MID$(OUTREC$,8,2)))
  560. 15590  CLS:REC=REC+1:GOTO 15550
  561. 15600  IF MID$(OUTREC$,1,3)="p01" THEN GOTO 15780
  562. 15610  LOCATE (VAL(MID$(OUTREC$,4,2))),(VAL(MID$(OUTREC$,6,2))),0
  563. 15620  IF VAL(MID$(OUTREC$,6,2))>8 THEN PRINT MID$(OUTREC$,8,78-(VAL(MID$(OUTREC$,6,2))))
  564. 15630  IF VAL(MID$(OUTREC$,6,2))<9 THEN PRINT MID$(OUTREC$,8,70)
  565. 15640  IF MID$(OUTREC$,82,1) <> " " AND MID$(OUTREC$,82,1) <> "I" THEN GOTO 15680
  566. 15650  REC = REC +1
  567. 15660  IF VAL(MID$(OUTREC$,78,4)) <> 0 THEN REC=VAL(MID$(OUTREC$,78,4))
  568. 15670  GOTO 15550
  569. 15680  IF MID$(OUTREC$,82,1) <> "P" THEN GOTO 15740
  570. 15690  LOCATE 23,28,0:PRINT "Press Any Key to Continue"
  571. 15700  GOSUB 15220:IF SKIP$ <> NOW$ THEN GOTO 15770
  572. 15710  CLS:REC=REC+1
  573. 15720  IF VAL(MID$(OUTREC$,78,4)) <> 0 THEN REC=VAL(MID$(OUTREC$,78,4))
  574. 15730  GOTO 15550
  575. 15740  IF MID$(OUTREC$,82,1) <> "E" THEN GOTO 15770
  576. 15750  LOCATE 23,28,0:PRINT "Press Any Key to Continue"
  577. 15760  GOSUB 15220
  578. 15770  CLOSE #2:RETURN
  579. 15780  IF MID$(OUTREC$,4,1) = "1" THEN LPRINT
  580. 15790  LPRINT USING "&     &";MID$(OUTREC$,8,35);MID$(OUTREC$,43,35)
  581. 15800  IF MID$(OUTREC$,82,1) <> " " AND MID$(OUTREC$,82,1) <> "I" THEN GOTO 15840
  582. 15810  REC = REC +1
  583. 15820  IF VAL(MID$(OUTREC$,78,4)) <> 0 THEN REC=VAL(MID$(OUTREC$,78,4))
  584. 15830  GOTO 15550
  585. 15840  CLOSE #2:RETURN
  586. 15850  REC=615:GOSUB 15490:GOSUB 15220:GOTO 15790        ' printer not ready
  587. 15860  CLS:PRINT "Your disk drive is not ready.  Please insert The Designer's"
  588. 15870  PRINT "disk in Drive A and close the door."
  589. 15880  PRINT
  590. 15890  PRINT "Press any key to Continue"
  591. 15900  GOSUB 15220:GOTO 15530
  592. 15910  REC=623:GOSUB 15490:GOSUB 15220:GOTO 15530        ' disk i/o error
  593. 15920  REM *************************************************************
  594. 15930  REM **                 Sound Effects                           **
  595. 15940  REM *************************************************************
  596. 15950  IF MSG = 0 THEN PLAY "t255mso3c8c8c8"
  597. 15960  IF MSG > 0 THEN PLAY "t255o1c8e-8c8e-8"
  598. 15970  RETURN
  599.